SuperHack/SuperHack CD.bin/CODING/SOUND/FM-EXT21.ZIP/SOURCE/FM-EXT.PAS

Pascal/Delphi Source File | 1996-01-01 | 72.4 KB | 2,460 lines

Program Fast_Module_Extractor;

{$L FONT.OBJ}

{$DEFINE DEBUG} {Disable to compile release version}

Uses EnhDOS, Strings;

Const Buffer = 32767;              {Size of search-buffer           }
      version = '2.1 ';            {Version-number, must be 4 chars!}

Type bytearray = Array [0..Buffer] Of char;
     CharSet = Set OF Char;

Var
  header                    :array[1..4] of char;
  option                    :array[1..3] of string;
  sample                    :bytearray;
  doserror                  :integer;
  attr, found, res,
  FilesInDir, patternsize, x, y,fx    :word;
  FileNum,l                 :longint;
  infile1, infile2          :byte;
  ID,filename               :string;
  pP,pFileName              :pchar;
  Search                    :tsearchrec;
  D                         :tdirstr;
  N                         :tnamestr;
  E                         :textstr;
  AutoMode,ReadOnlyFile     :boolean;
  TheTime                   :real;


Procedure Setfont;external;
{Changes the textmode font to the one defined in FONT.OBJ
   input: -
  output: - }

Function IsVGA: boolean;assembler;
{Checks for a VGA-card
   input: -
  output: IsVGA         - boolean : True when VGA found
                                    False when no VGA found}
asm
   xor     bx,bx
   mov     ax,01A00h
   int     010h
   mov     ax,1
   cmp     bl,7
   jnc     @@ok
   cmp     bl,8
   jnc     @@ok
   xor     ax,ax
@@ok:
end;

Function TestBit(x,bits:byte):boolean;assembler;
asm
  xor ax,ax
  mov bl,x
  test bl,bits
  jz @false
  mov ax,1
@false:
end;

procedure ClrScr;assembler;
  asm
    mov ax,0B800h
    mov es,ax
    mov di,0h
    mov cx,80*25
    mov ax,0700h
    cld
    rep stosw
  end;

function ReadKey:char;assembler;
{Reads a key from the keyboard via the BIOS
   input: -
  output: ReadKey         - char : value from keyboard}

asm
   xor ah,ah
   int 16h
   {The function 'readkey' returns the value in AL}
end;

Procedure FastWrite(s:string;x,y:word;Attr:byte);assembler;
{Writes a string directly to the textscreen; Color only
   input: s               - string : string to display
          x               - word   : column
          y               - word   : row
          Attr            - byte   : attribute for string
  output: -                                   }

asm
   push ds            {TP7 doesn't save DS    }
   mov ax,y           {Get row                }
   dec ax             {Convert to zero-based  }
   mov dx,80          {80 columns             }
   mul dx             {Multiply row with 80   }
   dec ax             {Convert to zero-based  }
   add ax,x           {Get column             }
   shl ax,1           {Multiply by 2          }
   mov si,ax          {Save it in SI          }

   mov ax,0B800h      {Value of text-segment  }
   mov es,ax          {Save it in ES          }
   xor cx,cx          {Clear CX               }
   lds di,s           {Load location of string}
   mov cl,ds:[di]     {Get length of string   }
   mov bh,attr        {Get attribute          }

@w:inc di             {Increment DI           }
   mov bl,ds:[di]     {Get next char of string}
   mov es:[si],bx     {Put on the screen      }
   inc si             {Increment SI twice     }
   inc si
   loop @w            {Loop CX times          }
   pop ds             {Pop DS back            }
end;

Procedure cursoroff;assembler;
{Turns cursor off
   input: -
  output: -      }
asm
   mov   ax,0100h
   mov   cx,2607h
   int   10h
end;

Procedure cursoron;assembler;
{Turns cursor on
   input: -
  output: -      }
asm
    mov   ax,0100h
    mov   cx,0506h
    int   10h
end;

Procedure Upper(var s: string);assembler;
{Converts a string to uppercase-chars
   input: s               - string : string to convert
  output: s               - string : converted string    }

asm
   push    ds              { Save DS on stack }
   lds     si, S           { Load DS:SI With Pointer to S }
   cld                     { Clear direction flag - String instr. Forward}
   lodsb                   { Load first Byte of S (String length Byte) }
   sub     ah, ah          { Clear high Byte of AX }
   mov     cx, ax          { Move AX in CX }
   jcxz    @Done           { Length = 0, done }
   mov     ax, ds          { Set ES to the value in DS through AX }
   mov     es, ax          { (can't move between two segment Registers) }
   mov     di, si          { DI and SI now point to the first Char. }
@UpCase:
   lodsb                   { Load Character }
   cmp     al, 'a'
   jb      @notLower       { below 'a' -- store as is }
   cmp     al, 'z'
   ja      @notLower       { above 'z' -- store as is }
   sub     al, ('a' - 'A') { convert Character in AL to upper Case }
@notLower:
   stosb                   { Store upCased Character in String }
   loop    @UpCase         { Decrement CX, jump if not zero }
@Done:
   pop     ds              { Restore DS from stack }
end;

Procedure ClearLine;
{Clears the statusline
   input: -
  output: -      }
begin
  FastWrite('                                                                               ',1,14,112);
end;

function ToStr(n:longint;i:byte):string;
var t:string;
begin
  Str(n:i,t);
  ToStr:=t;
end;

Function GetString(cx,cy,cc,pc:byte;default,prompt:string;MaxLen:integer;OKSet :charset):string;
{Get a string from the keyboard, very sophisticated!
   input: cx              - byte   : column for input
          cy              - byte   : row for input
          cc              - byte   : attribute for input
          pc              - byte   : attribute for prompt
          default         - string : default input-string
          prompt          - string : prompt
          MaxLen          - integer: maximum length of input
          OkSet           - charset: allowed characters
  output: GetString       - string : returns given string}

const
  BS                 = #8;
  CR                 = #13;
  ESC                = #27;
  iPutChar           = #249;
  ConSet             : CharSet = [BS,CR,ESC];
var
  TStr:string;
  x,i,tlen:byte;
  Ch:char;

begin
  TStr := '';
  TLen := 0;
  FastWrite(prompt,cx,cy,pc);
  x := cx + ord(Prompt[0]);
  For i := x to (x + Maxlen - 1) do FastWrite(iputChar,i,cy,cc);
  if default<>'' then FastWrite(default,x,cy,cc);
  OKSet := OKSet + ConSet;
  cursoron;
  repeat
    asm
      mov ah,2
      mov dh,cy
      dec dh
      mov dl,x
      dec dl
      mov bh,0
      int 10h
    end;
    repeat
       ch:=readkey
    until ch in OKSet;
    if tlen=0 then for i := x to (x + ord(default[0])) do FastWrite(iputChar,i,cy,cc);
    case ch of
    BS: begin
          if TLen > 0 then begin
                             dec(TLen);
                             dec(x);
                             FastWrite(iPutChar,x,cy,cc);
                           end;
        end;
    else if (Ch<>CR) and (Ch<> ESC) and (TLen < MaxLen) then
         begin
           FastWrite(Ch,x,cy,cc);
           inc(TLen);
           TStr[TLen] := Ch;
           inc(X);
         end;
    end;
  until (Ch = CR) or (Ch = ESC);
  If Tlen > 0 Then Begin
                     TStr[0] := chr(Tlen);
                     Getstring := TStr
                   End
  Else Getstring := Default;
  cursoroff;
  clearline;
end;


Procedure DrawLine(Line: integer;color:byte);
{Draw a line at a given position and in a given color
   input: line            - integer: row to draw the line
          color           - byte   : attribute for line
  output: -                                   }

var i: Integer;
begin
  FastWrite('■',1,line,color);
  For i := 2 To 79 Do FastWrite('─',i,line,color);
  FastWrite('■',80,line,color);
End;

procedure drawbar(m,column,line:byte);
{Draw a percentage-bar at a given position
   input: m               - byte   : percentage to display (0..100%)
          line            - byte   : row to display bar
  output: -                                   }

var tmp:string;
begin
  For Y := 2 To (m+1) Do
  Begin
    FastWrite('█',column+(Y shr 2),line,126);
    Str(m:3,tmp);
    FastWrite(' '+tmp+'%  ',column+25,line,126);
  End;
End;

function IntelLong(motorola:LongInt):LongInt;assembler;
{Converts a Motorola DWORD to a Intel DWORD
   input: motorola        - longint: motorola DWORD
  output: intellong       - longint: intel DWORD    }

asm
   mov  ax,[word ptr motorola]
   mov  dx,[word ptr motorola+2]
   xchg al,ah
   xchg dl,dh
   xchg ax,dx
end;

procedure SmoothExit;
{Scroll the screen up (SMOOTH) and exit to OS
   input: -
  output: -      }
var i,vel:word;
begin
  i:=0;
  vel:=0;
  REPEAT {Credits to VangeliSTeam for this code!}
      WHILE (Port[$3DA] AND 8) =  8 DO;
      asm cli end;
      Port[$3d4] := $c; Port[$3d5] := HI((i DIV 16)*80);
      Port[$3d4] := $d; Port[$3d5] := LO((i DIV 16)*80);
      WHILE (Port[$3DA] AND 8) <> 8 DO
      Port[$3d4] := 8; Port[$3d5] := (Port[$3d5] AND $E0) OR (i AND $0F);
      asm
          sti
          add vel,10
      end;
      i := i + (vel shr 4);
  UNTIL i >= 25*16;
  CursorOn;
  asm
   mov ax,3h
   int 10h
  end;
  ClrScr;
  Halt;
end;

Procedure waitforkey;
{Wait for a key-press
   input: -
  output: -          }
begin
  FastWrite('■',2,18,252);
  if Readkey=#27 then SmoothExit
                 else clearline;
  FastWrite(' ',2,18,112)
End;

Function SaveIt(s:string;position:longint):boolean;
{Asks the user to save a file
   input: s               - string : type of file to save
          position        - longint: position of found file
  output: SaveIt          - boolean: True when user wants to save else false}

begin
  if AutoMode=False then
  begin
    clearline;
    FastWrite (s+' found at position '+ToStr(position,0)+'. Save it (Y/n/a)?',2,14,121);
    Case ReadKey of
        #13,'y','Y': SaveIt:=True;
            'a','A': begin
                       SaveIt:=True;
                       AutoMode:=True;
                     end;
                #27: SmoothExit;
    else begin
           SaveIt:=False;
           FastWrite('                                               ',2,11,121);
         end;
    End;
    clearline;

  end
  else SaveIt:=True;
end;

Procedure WriteFile (ext:string;filebegin,filelength: LongInt);
{Copies a part from a file to another file
   input: ext             - string : extension for new file
          filebegin       - longint: startposition in old file
          filelength      - longint: length of new file
  output: -                                   }

Var filelengthstr,fileout:string;
  outfile: byte;
  err:word;
  pfileout:pchar;
  writebuffer: Array [1..32768] Of Byte;
  numread,buffers: Integer;
  temp:char;
  e,i: LongInt;
  continue:boolean;
  OldSearchRec:TSearchRec;

Begin
  GetMem(pFileOut,80);
  OldSearchRec:=Search;
  repeat
    continue:=true;
    clearline;
    cursoron;
    inc(filenum);
    if AutoMode = False then fileout:=GetString(2,14,121,121,ToStr(filenum,0)+'.'+ext,'Enter filename: ',62,['!'..'~'])
                        else fileout:=ToStr(filenum,0)+'.'+ext;
    pfileout:=pas2pchar(fileout);
    if existsfile(pfileout) then
      begin
        cursoroff;
        if AutoMode = False then begin
                                   FastWrite('File already exists. Overwrite it ['+fileout+'] (Y/n)',2,14,121);
                                   temp:=readkey;
                                   if (temp=#78) or (temp=#110) then continue:=false
                                                                else continue:=true
                                 end
                            else continue:=true;
        clearline;
        DeleteFile(pfileout);
      end;
   until continue;
  if Abs(DiskFree(0))<Filelength then begin
                                     FastWrite('Disk full; Cannot save file',2,14,121);
                                     waitforkey;
                                     continue:=false;
                                    end
                                 else
  begin
  cursoroff;
  err:=h_LSeek(infile2,filebegin,0);
  outfile:=h_Createfile(pfileout);
  buffers:=(filelength div sizeof(writebuffer));
  str(filelength:9,filelengthstr);
  for i:=1 to buffers do
    begin
      h_read(infile2,writebuffer,sizeof(writebuffer));
      h_write(outfile,writebuffer,sizeof(writebuffer));
{      str(4096*i:9,tempstring);}
      FastWrite('Processing: '+ToStr(32768*i,9)+' bytes of '+filelengthstr+' bytes',2,9,121);
      drawbar((100*32768*i) div filelength,50,9);
    end;
  h_read(infile2,writebuffer,filelength-(32768*buffers));
  h_write(outfile,writebuffer,filelength-(32768*buffers));
  FastWrite(' Processing: '+filelengthstr+' bytes of '+filelengthstr+' bytes',1,9,121);
  drawbar(100,50,9);
  h_closefile(outfile);
  for i:=50 to 50+24 do FastWrite('▒',i,9,112);
  FastWrite('   ',76,9,121);
  FastWrite('                                               ',2,11,121);
  FastWrite(' Processing:           bytes of           bytes',1,9,121);
  Search:=OldSearchRec;
  end;
End;

Procedure DisplayHelp;
{Displays help-screen and asks commandline
   input: -
  output: -          }

var i,o:byte;
    tmp:string;
begin;
    for x:=1 to 80 do FastWrite(' ',x,1,79);
    FastWrite (' Fast Module Extractor '+version,1,1,79);
    for x:=2 to 25 do for y:=1 to 80 do FastWrite(' ',y,x,112);
    FastWrite (' Usage: FM-EXT filename <options>',1,3,126);
    FastWrite (' Extracts: MOD, STM, S3M, 669, MTM, AMF, PAC, DSM, FNK, GDM',1,6,121);
    FastWrite ('           FAR, ULT, MDL, PTM, DMF, UNI, PSM, AMS, MXM, XM',1,7,121);
    FastWrite ('           MID, XMI, HMP, MUS, CMF, SAT, SA2, RAD, D00, DLZ',1,8,121);
    FastWrite ('           WAV, VOC, 8SX, AIF, SBK, AU',1,9,121);
    FastWrite ('           BMP, LBM, SCX, PCX, GIF, JPG',1,10,121);
    FastWrite ('           FLI, FLC, AVI, ANM, MOV',1,11,121);
    FastWrite (' Wildcards allowed!',1,15,124);
    FastWrite ('  Options: X                Turn on 669, FLI, FLC searching',1,17,120);
    FastWrite ('           !<ABCD> <offset> Custom header search (1..255 chars!)',1,18,120);
    FastWrite ('           #<begin> <end>   Partial copy mode',1,19,120);
    FastWrite (' See DOCs for details',1,21,127);
    drawline(23,125);
    drawline(25,117);
    tmp:=GetString(2,24,7,7,'','>FM-EXT ',70,[' '..#255]);
    pp:=Pas2PChar(tmp);
    i:=0;
    for x:=1 to 3 do
    begin
      if pp[i]=' 'then
         repeat inc(i) until pp[i]<>' ';
      o:=1;
      repeat
        option[x,o]:=pp[i];
        inc(i);
        inc(o);
      until (pp[i]=' ') or (pp[i]=#0);
      option[x,0]:=chr(o-1);
    end;
End;

Procedure write669;
{Checks for ComposD 669 files
   input: -
  output: -          }

Var title669: Array [1..108] Of Char;
  nos, nop: Byte;
  sample: Word;
  begin669,temp,Length669, i: LongInt;

Begin
  Begin669 := (l - res) + X;  {Calculate 669 beginning}
  Length669 := 0;
  If (search.size - Begin669) > 110 Then
    begin
      h_LSeek (infile2, Begin669 + 2,0);
      h_Read (infile2, title669, SizeOf (title669) );
      h_LSeek(infile2, Begin669 + 110,0);
      h_Read (infile2, nos,SizeOf (nos) ); {Read # of samples}
      h_Read (infile2, nop,SizeOf (nop) ); {Read # of patterns}
      h_LSeek (infile2, begin669 + 510,0);
      For i := 1 To nos Do
        Begin              {Read NOS times the sample lengths}
          h_Read (infile2, sample, SizeOf (sample) );
          h_LSeek (infile2, (begin669 + 510) + (i * $19),0 );
          Length669 := Length669 + sample;
        End;
      temp:=nop;
      Length669 := Length669 + (temp * 1536);
      temp:=nos;
      Length669 := Length669 + (temp * $19) +$1F1; {Calculate total length}
      if (length669 > 0) and ((Begin669 +length669) <= search.size) Then
      begin
        FastWrite ('Title: ',2,11,113);
        For i := 1 To 36 Do FastWrite (title669 [i],39+i,9,113);
        ID:='669 File';
        if SaveIt(ID,begin669) then writefile ('669',begin669,Length669);
        FastWrite('                                             ',39,10,113);
        FastWrite('                                             ',39,11,113);
      end;
    end;
End;

Procedure writeS3M;
{Checks for ScreamTracker 3.x  files
   input: -
  output: -          }

Var titleS3M: Array [1..28] Of Char;
  noo, nos, nop: Word;
  sample: Word;
  memseg: Word;
  i,begins3m, lengths3m, memsegold, Length: LongInt;
  t: Byte;

Begin
  lengths3m := 0;
  memsegold := 0;
  Begins3m := (l - res) + X - 44;
  h_LSeek (infile2, Begins3m,0);
  h_read (infile2, titleS3M, SizeOf (titleS3M) ); {Read title}
  h_LSeek (infile2, Begins3m + 32,0);
  h_read (infile2, noo, SizeOf (noo) ); {Read # of orders}
  h_read (infile2, nos, SizeOf (nop) ); {Read # of patterns}
  h_read (infile2, nop, SizeOf (nos) ); {Read # of samples}
  h_LSeek (infile2, begins3m + 96 + noo,0);
  if (nos <> 0) and (nos < 100) then For i := 0 To nos - 1 Do                 {Read NOS times the pointers to all samples}
    Begin
      h_LSeek (infile2, begins3m + 96 + noo + i + i,0);
      h_read (infile2, sample, SizeOf (sample) );
      h_LSeek (infile2, 14 + begins3m + (sample * 16) ,0);
      h_read (infile2, memseg, SizeOf (memseg) );
      If memseg > memsegold Then
        Begin
          memsegold := memseg;
          h_read (infile2, Length, SizeOf (Length) ); {Read last sample length}
          lengths3m := (memsegold * 16) + Length;        {Add last sample length and last filepointer}
        End;
      End;
  if (lengths3m > 0) and ((Begins3m +lengths3m) <= search.size) Then
  begin
    ID:='ScreamTracker 3.0';
    FastWrite ('Title: '+ titleS3M,2,11,113);
    if SaveIt(ID,BeginS3M) then writefile ('S3M',begins3m,lengths3m);
  end;
End;

Procedure writeMTM; {Extracts MultiTracker 1.x files}
{Checks for MultiTracker 1.x files
   input: -
  output: -          }


Var titleMTM: Array [1..20] Of Char;
  lps, nos: Byte;
  loc, trks: Word;
  i,beginmtm, lengthmtm, sample: LongInt;

Begin
  BeginMTM := (l - res) + X;
  lengthmtm := 0;
  If (search.size - BeginMTM) > 100 Then
    begin
      h_LSeek (infile2, Beginmtm + 4,0);
      h_read (infile2, titleMTM, SizeOf (titleMTM) ); {Read title}
      h_LSeek (infile2, Beginmtm + 24,0);
      h_read (infile2, trks, SizeOf (trks) ); {Read # of tracks}
      h_read (infile2, lps, SizeOf (lps) );   {Read # of ?}
      h_LSeek (infile2, beginmtm + 28,0);
      h_read (infile2, loc, SizeOf (loc) );
      h_read (infile2, nos, SizeOf (nos) );   {Read # of samples}
      lengthMTM := (194 + (nos * 37) + (trks * 192) + ( (lps + 1) * 32 * 2) + loc);
      h_LSeek (infile2, beginMTM + 88,0);
      For i := 1 To nos Do
         begin
           h_read (infile2, sample, SizeOf (sample) );
           h_LSeek (infile2, (beginmtm + 88) + (i * 37) ,0);
           lengthMTM := lengthMTM + sample;
         end;
      if (lengthmtm > 0) and ((Beginmtm + lengthmtm) <= search.size) Then
        begin
          FastWrite('Title: '+titleMTM,2,11,113);
          ID:='MultiTracker Module';
          if SaveIt(ID,beginmtm) then writefile ('MTM',beginmtm,lengthmtm);
        end;
    end;
End;

Procedure WriteMOD;{(patternsize: word); {Flexible MOD file extractor}
{Checks for MOD-type files (1..32 channel
   input: -
  output: -          }

Var i, modbegin,modlength: LongInt;
    title: Array [1..20] Of Char;
    Pattern: Array [1..128] Of Byte;
    number,laag, hoog: Byte;

Begin
  MODBegin := (l - res) + X - 1080;
  number:=0;
  modlength := 0;
  if (ModBegin >= 0) and (patternsize <= 32*256) then
    begin
      h_LSeek (infile2, ModBegin,0);
      h_read (infile2, title, SizeOf (title) ); {Reads title}
      h_LSeek (infile2, ModBegin + 42,0);
      For i := 1 To 31 Do  {Reads sample sizes}
         Begin
           h_read (infile2, hoog, SizeOf (hoog) );
           h_read (infile2, laag, SizeOf (laag) );
           h_LSeek (infile2, ModBegin + 42 + (i * 30) ,0);
           modlength := modlength + ( (hoog * 256) + laag);
         End;
      modlength := modlength * 2;
      h_LSeek (infile2, Modbegin + 952,0);
      h_read (infile2, Pattern, 128); {Reads pattern order, highest number -> number of patterns}
      For i := 1 To 128 Do If number < Pattern [i] Then number := Pattern [i];
      i:=patternsize; {Must convert patternsize to longint...causes otherwise an FP error}
      modlength := modlength + ( (number + 1)* i) + 1084;
      h_LSeek (infile2, ModBegin,0);
      if (modlength > 1081) and ((ModBegin +Modlength) <= search.size) Then
        begin
          FastWrite('Title: '+ title,2,11,113);
          ID:=ToStr(patternsize div 256,0)+' Channel MOD File';
          if SaveIt(ID,ModBegin) then writefile('MOD',modbegin,modlength);
       end;
    end;
End;

Procedure writeSTM; {Extracts ScreamTracker 2.x / BMOD2STM / SWavePro files}

Var i, beginstm,stmlength: LongInt;
  header: array[1..8] of Char;
  title: Array [1..20] Of Char;
  los: Word;
  nop: Byte;

Begin
  BeginSTM := (l - res) + X - 24;
  stmlength := 0;
  h_LSeek (infile2, Beginstm + $14,0);
  h_read (infile2, header, SizeOf(header));
  if (header='!Scream!') or (header='BMOD2STM') or (header='SWavePro') then
  begin
      h_LSeek (infile2, Beginstm,0);
      h_read (infile2, title, SizeOf (title) );
      h_LSeek (infile2, Beginstm + 33,0);
      h_read (infile2, nop, SizeOf (nop) ); {Read # of patterns}
      h_LSeek (infile2, Beginstm + 64,0);
      stmlength := nop;
      stmlength := stmlength * 1024;
      For i := 1 To 31 Do
      Begin
        h_read (infile2, los, SizeOf (los) );
        h_LSeek (infile2, Beginstm + 64 + (i * 32) ,0);
        If (los mod 16) <> 0  Then los := 16*(los Div 16);
        stmlength := stmlength + los;
      End;
     stmlength := stmlength + (31 * 32) + 48 + 128;
     if (stmlength > 0) and ((Beginstm +stmlength) <= search.size) Then
     begin
       FastWrite ('Title: '+ title,2,11,113);
       ID:='ScreamTracker 2.x';
       if SaveIt(ID,beginstm) then writefile ('STM',beginstm,stmlength);
     end;
   end;
End;

Procedure writeAMF; {Extracts DMP format .AMF, copies from header to end of file}
                    {so the length isn't always accurate}
Var amfbegin,amflength: LongInt;
  title: Array [1..30] Of Char;
  version:byte;
Begin
  AMFBegin := (l - res) + X;
  amflength := 0;
  h_LSeek (infile2, amfBegin + 3,0);
  h_read (infile2, version, SizeOf(version));
  if version<=20 then
  begin
  h_read (infile2, title, SizeOf (title) );
  FastWrite ('Title: '+ title,2,11,113);
  amflength := search.size - amfbegin;
  ID:='AMF File';
  if SaveIt(ID,amfbegin) then writefile ('AMF',amfbegin,amflength);
  end;
End;

Procedure writeDMF; {Delusion Music Format}
type
  dmfhead = record
                chunk: array[1..4] of char;
              version: byte;
              tracker: array[1..8] of char;
                 song: array[1..30] of char;
             composer: array[1..20] of char;
                 date: array[1..3] of byte;
            end;

var nextblock,dmfbegin,dmflength: LongInt;
    chunk:array[1..4] of char;
    i:byte;
    dmfheader: dmfhead;

Begin
  dmfBegin := (l - res) + X;
  dmflength := 0;
  h_LSeek(infile2, dmfBegin,0);
  h_read(infile2, dmfheader, SizeOf(dmfheader));
  i:=0;
  repeat
    h_read(infile2,chunk,4);
    h_read(infile2,nextblock,4);
    if chunk <> 'ENDE' then begin
                            h_LSeek(infile2,nextblock,1);
                            dmflength:=dmflength+nextblock;
                            end;
    inc(i);
  until (chunk = 'ENDE') or (i>16);
  dmflength:=dmflength+(i*8)+sizeof(dmfheader) - 4;
  if (dmflength > 0) and ((dmfBegin + dmflength) <= search.size) then
    begin
      FastWrite ('Title: '+ dmfheader.song,2,11,113);
      ID:='Delusion Music File';
      if SaveIt(ID,dmfbegin) then writefile ('DMF',dmfbegin,dmflength);
    end;
End;

Procedure writeVOC; {Creative Voice File}
var VOCbegin,VOClength: LongInt;
    header: Array [1..20] Of Char;
    blocklength:longint;
    u,datatype:byte;

Begin
  VOCBegin := (l - res) + X;
  voclength := 0;
  blocklength:=0;
  h_LSeek (infile2, VOCBegin,0);
  h_read (infile2, header, SizeOf(header));
  if header='Creative Voice File'+#$1A then
  begin
    h_LSeek (infile2,VOCBegin+26,0);
    h_read (infile2,datatype,sizeof(datatype));
    h_read (infile2,blocklength,3);
    VocLength:=Blocklength + 3;
    u:=0;
    repeat
      h_LSeek(infile2,blocklength,1);
      h_read(infile2,datatype,1);
      blocklength:=0;
      if datatype<>0 then h_read(infile2,blocklength,3);
      VocLength:=VocLength + Blocklength + 3;
      inc(u);
    until (datatype=00) or (u > 16);
    VocLength:=VocLength+26;
    if (VOClength > 0) and ((VOCbegin+VOClength) <= search.size) Then
    begin
    ID:='Creative Voice File';
    if SaveIt(ID,vocbegin) then writefile ('VOC',vocbegin,voclength);
    end;
  end;
End;

Procedure writeMDL;
Var mdlbegin,mdllength,blocklen: LongInt;
                          title: array[1..32] of Char;
                        blockID: array[1..2] of char;
                              i: byte;
begin
  MDLBegin := (l - res) + X;
  mdllength := 5;
  h_LSeek (infile2, mdlBegin + 11,0);
  h_read (infile2, title, sizeof(title));
  h_LSeek (infile2, mdlBegin + 5,0);
  h_read (infile2, blockID, 2);
  i:=1;
  repeat
    h_read(infile2, blocklen, 4);
    MDLlength:=MDLLength+blocklen+6;
    h_LSeek(infile2, MDLbegin + MDLlength,0);
    h_read(infile2, blockID,2);
    inc(i);
  until (blockID='SA') or (i > 16);
  h_read (infile2, blocklen, 4);
  MDLlength:=MDLLength+blocklen+6;
  if (mdllength > 0) and ((MdlBegin +Mdllength) <= search.size) Then
    begin
      FastWrite ('Title: '+ title,2,11,113);
      ID:='DigiTrakker MDL File';
      if SaveIt(ID,mdlbegin) then writefile ('MDL',mdlbegin,mdllength);
    end;
end;

Procedure writeXM; {Write's FastTracker 2.0 XM (Extended Module) files}

Var XMbegin,XMlength: LongInt;
    j,HeaderSize,PatternSize,InstrSize,SampHeadSize,SampleLength,TotalSample:Longint;
    PackPattSize:word;
    ii,i,NOP,NOI,NOS:word;
    check: Array [1..17] Of Char;
    title: Array [1..20] of Char;

Begin
  XMBegin := (l - res) + X;
  XMlength := 0;
  h_LSeek(infile2, XMBegin,0);
  h_read(infile2, check, sizeof(check));
  if check='Extended Module: ' then
    begin
      h_LSeek(infile2, XMBegin+17,0);
      h_read(infile2, title, sizeof(title));
      h_LSeek(infile2, XMBegin+60,0);
      h_read(infile2, headersize,4);
      h_LSeek(infile2, XMBegin+70,0);
      h_read(infile2, NOP,2);
      h_LSeek(infile2, XMBegin+72,0);
      h_read(infile2, NOI,2);
      if (NOI<=128) and (NOP<=256) then
        begin
          patternsize:=0;
          PackPAttSize:=0;
          j:=0;
          for i:= 1 to NOP do
            begin
              h_LSeek(infile2, XMBegin+60+headersize+j,0);
              h_read(infile2, patternsize,4);
              h_LSeek(infile2, XMBegin+60+headersize+j+7,0);
              h_read(infile2, PackPattSize,2);
              j:=j+packpattsize+patternsize;
            end;
          XMLength:=HeaderSize+60+j;
          j:=0;
          for i:= 1 to NOI do
            begin
              h_LSeek(infile2,XMBegin+XMLength+j,0);
              h_read(infile2, Instrsize,4);
              h_LSeek(infile2,XMbegin+XMLength+j+27,0);
              h_read(infile2, NOS,2);
              if NOS<>0 then
                begin
                  h_LSeek(infile2,XMBegin+XMLength+j+29,0);
                  h_read(infile2,SampHeadSize,4);
                  j:=j+InstrSize;
                  TotalSample:=0;
                  for ii:=1 to NOS do
                    begin
                      h_LSeek(infile2,XMBegin+XMLength+j,0);
                      h_read(infile2,SampleLength,4);
                      j:=j+SampHeadSize;
                      TotalSample:=TotalSample+Samplelength;
                    end;
                  j:=j+TotalSample;
                end
              else
              j:=j+InstrSize;
            end;
          XMLength:=XMLength+j;
          if (xmlength > 0) and ((xmBegin + xmlength) <= search.size) Then
            begin
              FastWrite ('Title: '+ title,2,11,113);
              ID:='FastTracker 2.0 File';
              if SaveIt(ID,xmbegin) then writefile('XM',xmbegin,xmlength);
            end;
        end;
    end;
End;


Procedure writeFAR; {Extracts Farandole composer files}
                    {Reads from header to end of file, so search.name isn't always OK}
Var i, farbegin,farlength: LongInt;
  title: Array [1..40] Of Char;
  headerlength,songtextlength:word;
  nop:byte;
Begin
  farBegin := (l - res) + X;
  farlength := 0;
  h_LSeek (infile2, farBegin + 4,0);
  h_read (infile2, title, SizeOf (title) );
  FastWrite ('Title: '+ title,2,11,113);
  farlength := search.size - farbegin;
  ID:='Farandole File';
  If SaveIt(ID,farbegin) then writefile ('FAR',farbegin,farlength);
End;

Procedure writeGDM;
Var i, gdmbegin,gdmlength: LongInt;
  title: Array [1..32] Of Char;
  headerlength,songtextlength:word;
  nop:byte;
Begin
  GDMBegin := (l - res) + X;
  h_LSeek (infile2, gdmBegin + 4,0);
  h_read (infile2, title, SizeOf (title) );
  FastWrite ('Title: '+ title,2,11,113);
  gdmlength := search.size - gdmbegin;
  ID:='GDM File';
  If SaveIt(ID,gdmbegin) then writefile ('GDM',gdmbegin,gdmlength);
End;

Procedure writeMXM;

Var i, mxmbegin,mxmlength: LongInt;
  title: Array [1..32] Of Char;
  headerlength,songtextlength:word;
  nop:byte;
Begin
  mxmBegin := (l - res) + X;
  mxmlength := search.size - mxmbegin;
  ID:='MXM File';
  If SaveIt(ID,mxmbegin) then writefile ('MXM',mxmbegin,mxmlength);
End;

Procedure writeANM;
Var i, ANMbegin,ANMlength: LongInt;
    nop:byte;
Begin
  ANMbegin := (l - res) + X;
  ANMlength := search.size - ANMbegin;
  ID:='GDM File';
  If SaveIt(ID,ANMbegin) then writefile ('ANM',ANMbegin,ANMlength);
End;

Procedure writeULT; {Extracts UltraTracker format, copies from header to end of file}
                    {so the length isn't always accurate}
Var i, ultbegin,ultlength: LongInt;
  title: Array [1..32] Of Char;
  header: array[1..15] of char;
Begin
  ULTBegin := (l - res) + X;
  ultlength := 0;
  h_read(infile2, header, sizeof(header));
  if header='MAS_UTrack_V001' then
  begin
    h_read (infile2, title, SizeOf (title) );
    FastWrite ('Title: '+ title,2,11,113);
    ID:='UltraTracker File';
    ultlength := search.size - ultbegin;
    if SaveIt(ID,ultbegin) then writefile ('ULT',ultbegin,ultlength);
  end;
End;

Procedure writePTM; {Extracts PolyTracker format, copies from header to end of file}
                    {so the length isn't always accurate...mostly NOT}
Var titlePTM: Array [1..28] Of Char;
  noo, nos, nop: Word;
  sample, slength: LongInt;
  i,beginPTM, lengthPTM, memsegold, Length: LongInt;
  t: Byte;

Begin
  lengthPTM := 0;
  memsegold := 0;
  BeginPTM := (l - res) + X - 44;
  h_LSeek (infile2, BeginPTM,0);
  h_read (infile2, titlePTM, SizeOf (titlePTM) ); {Read title}
  h_LSeek (infile2, BeginPTM + 32 + 2,0);
  h_read (infile2, nos, SizeOf(nos));
  h_LSeek (infile2, BeginPTM + 608 + 18,0);
  if nos <> 0 then
  begin
      h_LSeek (infile2, beginPTM+608 + 18 + ((nos-1)*80),0);
      h_read (infile2, sample, SizeOf(sample));
      h_read (infile2, slength, SizeOf(slength));
      lengthPTM:=slength+sample;
  end;
  if (lengthPTM > 0) and ((BeginPTM +lengthPTM) <= search.size) Then
  begin
    ID:='PolyTracker File';
    FastWrite ('Title: '+ titlePTM,2,11,113);
    if SaveIt(ID,beginPTM) then writefile ('PTM',beginPTM,LengthPTM);
  end;
End;

Procedure writePAC; {Extracts SB Studio PAC file}
Var i, pacbegin,paclength: LongInt;

Begin
  PACBegin := (l - res) + X;
  paclength := 0;
  h_LSeek (infile2, pacBegin + 4,0);
  h_read(infile2, paclength,4);
  paclength:=paclength+8;
  if (paclength > 0) and ((pacBegin + paclength) <= search.size) Then
    begin
      ID:='SB Studio .PAC File';
      if SaveIt(ID,pacbegin) then writefile ('PAC',pacbegin,paclength);
    end;
End;

Procedure writeFNK;
Var i, fnkbegin,fnklength: LongInt;

Begin
  fnkBegin := (l - res) + X;
  fnklength := 0;
  h_LSeek (infile2, fnkBegin + 8,0);
  h_read(infile2, fnklength,4);
  if (fnklength > 0) and ((fnkBegin + fnklength) <= search.size) Then
    begin
      ID:='FunkTracker File';
      if SaveIt(ID,fnkbegin) then writefile ('FNK',fnkbegin,fnklength);
    end;
End;

Procedure writePSM;
Var i, psmbegin,psmlength: LongInt;

Begin
  PSMBegin := (l - res) + X;
  psmlength := 0;
  h_LSeek (infile2, psmbegin + 4,0);
  h_read(infile2, psmlength,4);
  psmlength:=psmlength+12;
  if (psmlength > 0) and ((psmBegin + psmlength) <= search.size) Then
    begin
      ID:='PSM File';
      if SaveIt(ID,psmbegin) then writefile('PSM',psmbegin,psmlength);
    end;
End;

Procedure writeRIX;

Var i, Rixbegin,Rixlength: LongInt;
    rixhdr: record
              rix3:array[1..4] of char;  {Should be RIX3}
              xres, yres:integer;
              mode      :integer;
            end;
Begin
  rixBegin := (l - res) + X;
  rixlength := 0;
  h_LSeek(infile2, rixBegin,0);
  h_read(infile2, rixhdr, sizeof(rixhdr));
  rixlength:=longint(rixhdr.xres)*longint(rixhdr.yres)+778;
  if (rixlength > 0) and ((rixBegin + rixlength) <= search.size) Then
    begin
      ID:='ColoRIX Image';
      FastWrite ('Resolution: '+ToStr(rixhdr.xres,0)+' x '+ToStr(rixhdr.yres,0),2,11,113);
      if SaveIt(ID,rixbegin) then writefile ('SCX',rixbegin,rixlength);
    end;
End;

Procedure writeDLZ;
Var i, DLZbegin,DLZlength: LongInt;
    t1:byte;
    t2:word;
Begin
  DLZBegin := (l - res) + X - 6;
  DLZlength := 0;
  h_LSeek(infile2, DLZBegin + 9,0);
  h_read(infile2, t1,1);
  h_read(infile2, t2,2);
  DLZlength:=longint(t1)*$10000 + longint(t2) + 17;
  if (DLZlength > 0) and ((DLZBegin + DLZlength) <= search.size) Then
    begin
      ID:='Diet compressed datafile';
      if SaveIt(ID,DLZbegin) then writefile ('DLZ',DLZbegin,DLZlength);
    end;
End;

Procedure WriteUNI;
var  uniLength, uniBegin:longint;
     version:char;
Begin
  uniBegin := (l - res) + X;
  unilength := 0;
  unilength := search.size - unibegin;
  h_LSeek(infile2,unibegin+3,0);
  h_read(infile2,version, 1);
  if (version >= '0') and (version <= '9') then
    begin
      ID:='UniMOD File';
      If SaveIt(ID,unibegin) then writefile ('UNI',unibegin,unilength);
    end;
End;

Procedure WriteAMS;
var  amsLength, amsBegin:longint;
     header:array[1..8] of char;

Begin
  amsBegin := (l - res) + X;
  amslength := 0;
  amslength := search.size - amsbegin;
  h_LSeek(infile2,amsBegin,0);
  h_read(infile2,header,sizeof(header));
  if header='Extreme0' then
    begin
      ID:='Extreme Tracker Module';
      If SaveIt(ID,amsbegin) then writefile ('AMS',amsbegin,amslength);
    end;
End;

Procedure writeHMI;
Var i, hmibegin,hmilength: LongInt;
    header: array[1..8] of char;
Begin
  hmiBegin := (l - res) + X;
  hmilength := 0;
  h_LSeek(infile2, hmiBegin,0);
  h_read(infile2, header,sizeof(header));
  if header='HMIMIDIP' then
  begin
    h_LSeek(infile2, hmiBegin + $20,0);
    h_read(infile2, hmilength,4);
    if (hmilength > 0) and ((hmiBegin + hmilength) <= search.size) Then
      begin
        ID:='HMP MIDI file';
        if SaveIt(ID,hmibegin) then writefile ('HMP',hmibegin,hmilength);
      end;
  end;
End;

procedure writeMIDI; {Extract MIDI type 0 and 1 files}
var i,hoog,laag,noft:byte;
    midibegin,tracklength,midilength:longint;
begin
  midiBegin := (l - res) + X;
  midilength := 0;
  tracklength:=0;
  h_LSeek(infile2,midibegin+10,0);
  h_read(infile2,hoog,sizeof(hoog));
  h_read(infile2,laag,sizeof(laag));
  noft:=(hoog*256)+laag;  {Number of tracks}
  h_LSeek(infile2,midibegin+14,0);
  for i:=1 to noft do
    begin
      h_LSeek(infile2,h_filepos(infile2)+4+tracklength,0);
      h_Read(infile2,tracklength,sizeof(tracklength));
      tracklength:=IntelLong(tracklength);
      midilength:=midilength+tracklength;
    end;
  midilength:=midilength+14+(noft*8);
  if (midilength > 0) and ((midiBegin+midilength) <= search.size) Then
  begin
    ID:='MIDI File';
    if SaveIt(ID,midibegin) then writefile('MID',midibegin,midilength);
  end;
end;

Procedure writeMUS; {Extracts .MUS files}
Var MUSbegin,MUSlength: longint;
    start, length: word;

Begin
  MusBegin := (l - res) + X;
  MUSlength := 0;
  h_LSeek (infile2, MUSBegin + 4,0);
  h_read (infile2, Length, 2);
  h_read (infile2, Start, 2);
  MUSLength:=Longint(Start+Length);
  if (MUSlength > 0) and ((MUSBegin+MUSlength) <= search.size) Then
    begin
      ID:='MUS MIDI file';
      If SaveIt(ID,MUSbegin) then writefile ('MUS',MUSbegin,MUSlength);
    end;
End;


Procedure writeIFF; {Extracts LBM, XMI, IFF, AIF files}
Var i, IFFbegin,IFFlength: LongInt;
    header:array[1..4] of char;
    ext: array[1..3] of char;
    t: Byte;
    resolution:record
                 width,height:word;
               end;

Begin
  ext:='   ';
  IFFBegin := (l - res) + X;
  IFFlength := 0;
  h_LSeek (infile2, IFFBegin + 4,0);
  h_Read(infile2,IFFLength,sizeof(IFFLength));
  IFFLength:=IntelLong(IFFLength);
  h_LSeek(infile2, IFFBegin + 8,0);
  h_read(infile2, header,sizeof(header));
  h_LSeek(infile2, IFFBegin + 20,0);
  h_read(infile2, resolution,sizeof(resolution));
  resolution.width:=swap(resolution.width);
  resolution.height:=swap(resolution.height);
  IFFlength:=IFFlength+8;
  if (IFFlength > 0) and ((IFFBegin +IFFlength) <= search.size) Then
  begin
    if (header = 'ILBM') or (header = 'PBM ') then
                       begin
                         ID:='LBM Picture';
                         ext:='LBM';
                         FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
                         if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
                       end
    else
    if (header = 'ANBM') or (header='ANIM') then
                       begin
                         ID:='De Luxe Paint Animation';
                         ext:='ANM';
                         if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
                       end
    else
    if header = 'XMID' then
                       begin
                         ID:='XMI MIDI file';
                         ext:='XMI';
                         if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
                       end
    else
    if header = '8SVX' then
                       begin
                         ID:='8-bit SVX sound file';
                         ext:='8SX';
                         if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
                       end
    else
    if header = 'AIFF' then
                       begin
                         ID:='AIFF sound file';
                         ext:='AIF';
                         if SaveIt(ID,IFFbegin) then writefile (ext,IFFbegin,IFFlength);
                       end
    else begin
           ID:='Unknown IFF file ('+header+')';
           ext:='IFF';
           If SaveIt(ID,IFFBegin) then writefile(ext,IFFBegin,IFFLength);
         end;
  end;
End;

Procedure writeAU; {Extracts AU files}
Var AUbegin,AUlength, start, length: LongInt;

Begin
  AUBegin := (l - res) + X;
  AUlength := 0;
  h_LSeek(infile2, AUBegin + 4,0);
  h_read(infile2,start,sizeof(start));
  h_read(infile2,length,sizeof(length));
  AULength:=IntelLong(Start)+IntelLong(Length);
  if (AUlength > 0) and ((AUBegin+AUlength) <= search.size) Then
    begin
      ID:='AU sound file';
      If SaveIt(ID,AUbegin) then writefile ('AU',AUbegin,AUlength);
    end;
End;

Procedure writeBMP;
Var bmpbegin,BMPlength: LongInt;
    resolution:record
                 width,height:longint;
               end;

Begin
  bmpBegin := (l - res) + X;
  bmplength := 0;
  h_LSeek (infile2, bmpBegin + 2,0);
  if (search.size-bmpbegin) > 4 then h_read (infile2, bmplength, SizeOf (bmplength) ); {Reads length of BMP}
  h_LSeek(infile2, bmpBegin + $12,0);
  h_read(infile2, resolution,sizeof(resolution));
  if (abs(resolution.width) < 5000) and (abs(resolution.height) < 5000) then
  if (bmplength > 0) and ((bmpBegin +bmplength) <= search.size) Then
    begin
      ID:='BMP Picture';
      FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
      If SaveIt(ID,bmpbegin) then writefile ('BMP',bmpbegin,BMPlength);
    end;
End;

Procedure writeFLIorC;
Var flibegin,flilength: LongInt;

Begin
  fliBegin := (l - res) + X - 4;
  flilength := 0;
  h_LSeek (infile2, fliBegin,0);
  h_read(infile2,flilength,4);
  if (flilength > 0) and ((fliBegin + flilength) <= search.size) Then
    begin
      ID:='AutoDesk Animation';
      If SaveIt(ID,flibegin) then writefile ('FLI',flibegin,flilength);
    end;
End;

Procedure writeMOV;
Var movbegin,t,movlength: LongInt;
    header:array[1..4] of char;
Begin
  movBegin := (l - res) + X - 4;
  movlength := 0;
  h_LSeek(infile2,movBegin,0);
  h_read(infile2,t,4);
  movlength:=IntelLong(t);
  h_LSeek(infile2,movlength,0);
  h_read(infile2,t,4);
  movlength:=movlength+IntelLong(t);
  h_read(infile2,header,4);
  if header='moov' then
  if (movlength > 0) and ((movBegin + movlength) <= search.size) Then
    begin
      ID:='QuickTime Movie file';
      If SaveIt(ID,movbegin) then writefile ('MOV',movbegin,movlength);
    end;
End;

Procedure FoundRIFF;
var RiffLength,RiffBegin:longint;
    header:array[1..4] of char;
    ext:array[1..3] of char;


Begin
  RIFFbegin:= (l - res) + X;
  h_LSeek (infile2, RIFFbegin+8,0);
  h_read(infile2,header,sizeof(header));
  h_LSeek(infile2,RIFFbegin+4,0);
  h_read(infile2,RIFFLength,4);
  RIFFLength:=RIFFLength+8;
  if (RIFFlength > 0) and ((RIFFBegin + RIFFlength) <= search.size) Then
  if abs(RIFFLength)+abs(RIFFbegin) <= search.size then
  begin
    if header='WAVE' then begin
                            ID:='Windows Wave file';
                            ext:='WAV';
                            If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
                          end
    else
    if header='sfbk' then begin
                            ID:='Emu SoundFont file (AWE32)';
                            ext:='SBK';
                            If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
                          end
    else
    if header='AVI ' then begin
                            ID:='Windows AVI file';
                            ext:='AVI';
                            If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
                          end
    else
    if header='DSMF' then begin
                            ID:='Digital Sound Module';
                            ext:='DSM';
                            If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
                          end
    else begin
           ID:='Unknown RIFF file ('+header+')';
           ext:='RFF';
           If SaveIt(ID,RIFFBegin) then writefile(ext,RIFFBegin,RIFFLength);
         end;
  end;
end;

Procedure WriteGIF; {Only detection of GIF}
var header:record
           hdr:array[1..6] of char;
           width:word;
           height:word;
           colors:byte;
           end;
  gifbegin,giflength:longint;

Begin
  GIFBegin := (l - res) + X ;
  GIFlength := 0;
  h_LSeek (infile2, GIFBegin,0);
  h_read (infile2, header, SizeOf (header) );
  if (header.hdr='GIF87a') or (header.hdr='GIF89a') then
  begin
    GIFlength := 768+longint(header.width)*longint(header.height);
    ID:='GIF Picture';
    FastWrite ('Resolution: '+ToStr(header.width,0)+' x '+ToStr(header.height,0),2,11,113);
    If SaveIt(ID,GIFbegin) then writefile ('GIF',GIFbegin,GIFlength);
  end;
End;

Procedure WriteCMF;
var  cmfLength, cmfBegin:longint;

Begin
  cmfBegin := (l - res) + X;
  cmflength := search.size - cmfbegin;
  ID:='CMF File';
  If SaveIt(ID,cmfbegin) then writefile ('CMF',cmfbegin,cmflength);
End;

Procedure WriteD00;
var  cnt, d00Length, d00Begin:longint;
     title:array[1..32] of char;
     hdr:array[1..6] of char;
     ptr_table:array[1..5] of word;
     i:byte;
     ptr:word;
Begin
  d00Begin := (l - res) + X;
  d00length := search.size - d00begin;
  h_Lseek(infile2,d00Begin,0);
  h_read(infile2,hdr,sizeof(hdr));
  if hdr='JCH'+#$26+#$02+#$66 then
  begin
    h_Lseek(infile2,d00Begin+$b,0);
    h_read(infile2,title,sizeof(title));
    h_Lseek(infile2,d00Begin+$6b,0);
    h_read(infile2,ptr_table,sizeof(ptr_table));
    ptr:=0;
    cnt:=0;
    For i := 1 To 5 Do If ptr < ptr_table[i] Then ptr:=ptr_table[i];
    h_lseek(infile2,d00begin+ptr,0);
    d00length:=longint(ptr);
    repeat
      h_read(infile2,ptr,sizeof(ptr));
      inc(cnt,2);
    until (ptr=$FFFF) or (cnt>4000);
    inc(d00length,cnt);
    ID:='Vibrants D00 File';
    if (d00length > 0) and ((d00Begin + d00length) <= search.size) Then
    begin
      FastWrite('Title: '+ title,2,11,113);
      If SaveIt(ID,d00begin) then writefile ('D00',D00begin,d00length);
    end;
  end;
End;

Procedure WriteRAD;
var  radLength, radBegin:longint;
     rad_note:record
                channel,note,effect:byte;
              end;
     param,line,version:byte;
     radchk:array[1..16] of char;
     pat_table:array[1..32] of word;
     i,pat_off:word;
Begin
  radBegin := (l - res) + X;
  h_Lseek(infile2,RadBegin,0);
  h_read(infile2,radchk,sizeof(radchk));
  h_read(infile2,version,sizeof(version));
  if (radchk = 'RAD by REALiTY!!') and (version=$10) then
                 begin
                   h_read(infile2,version,sizeof(version));
                   if (version and $80) = $80 then
                   while version<>0 do h_read(infile2,version,sizeof(version));
                   h_read(infile2,version,sizeof(version));
                   while version<>0 do begin
                                          h_lseek(infile2,11,1);
                                          h_read(infile2,version,sizeof(version));
                                       end;
                   h_read(infile2,version,sizeof(version));
                   h_lseek(infile2,version,1);
                   h_read(infile2,pat_table,sizeof(pat_table));
                   pat_off:=0;
                   For i := 1 To 32 Do If pat_off < pat_table[i] Then pat_off:=pat_table[i];
                   h_lseek(infile2,radbegin+pat_off,0);
                   radlength:=pat_off;
                   repeat
                     h_read(infile2,line,sizeof(line));
                     inc(radlength);
                     repeat
                       h_read(infile2,rad_note,sizeof(rad_note));
                       if TestBit(rad_note.effect,$F) then
                       begin
                         h_read(infile2,param,sizeof(param));
                         inc(radlength);
                       end;
                       radlength:=radlength+3;
                     until (rad_note.channel and $80)=$80;
                   until (line and $80)=$80;
                   ID:='Reality Adlib Tracker File';
                   If SaveIt(ID,radbegin) then writefile ('RAD',radbegin,radlength);
              end;
End;

Procedure WriteSadt;
var  sadtLength, sadtBegin:longint;
     k,i,nop,notr:word;
     version:byte;
     ext:array[1..3] of char;
     trackorder:array[1..64,1..9] of byte;
Begin
  sadtBegin := (l - res) + X;
  h_Lseek(infile2,sadtBegin+4,0);
  h_read(infile2,version,sizeof(version));
  ID:='SAdT File';
  if version < 7 then begin
                        h_Lseek(infile2,sadtBegin+1097,0);
                        h_read(infile2,nop,sizeof(nop));
                        sadtlength := 1103 + longint(nop) * 2880;
                        ext:='SAT';
                      end;
  if (version >= 7) and (version <= 9) then
                      begin
                        h_Lseek(infile2,sadtBegin+1094,0);
                        h_read(infile2,nop,sizeof(nop));
                        h_Lseek(infile2,sadtBegin+1612,0);
                        h_read(infile2,trackorder,sizeof(trackorder));
                        notr:=0;
                        for k:=1 to nop do
                          for i := 1 To 9 Do if notr < trackorder[k,i] Then notr:=trackorder[k,i];
                        sadtlength := 2190 + longint(notr) * 192;
                        ext:='SA2';
                        end;
  if (sadtlength > 0) and ((sadtBegin + sadtlength) <= search.size) Then
  If SaveIt(ID,sadtbegin) then writefile ('SAT',sadtbegin,sadtlength);
End;

Procedure WriteJPG;

var  jpgLength, jpgBegin:longint;
     i:byte;
     JPG_ID:array[1..2] of char;
     header:record
               seg_id:byte;
               seg_type:byte;
               seg_sh:byte;
               seg_sl:byte;
             end;
    resolution:record
                 height,width:word;
               end;

Begin
  jpgBegin := (l - res) + X - 6 ;
  jpglength := 0;
  h_LSeek(infile2,JPGBegin,0);
  h_read(infile2,JPG_ID,2);
  if JPG_ID=#$FF+#$D8 then
  begin
  header.seg_sl:=0;
  header.seg_sh:=0;
  i:=0;
  repeat
    jpglength:=jpglength+longint((256*header.seg_sh)+header.seg_sl)+2;
    h_LSeek(infile2,jpglength,0);
    h_read(infile2,header,sizeof(header));
    inc(i);
  until (header.seg_id=$ff) and (header.seg_type>=$c0) and (header.seg_type<=$c1) or (i > 50);
  h_LSeek(infile2,jpglength+5,0);
  h_read(infile2,resolution,sizeof(resolution));
  resolution.width:=swap(resolution.width);
  resolution.height:=swap(resolution.height);
  jpglength := 768+longint(resolution.height)*longint(resolution.width)*2;
  FastWrite ('Resolution: '+ToStr(resolution.width,0)+' x '+ToStr(resolution.height,0),2,11,113);
  ID:='JPG Picture';
  If SaveIt(ID,jpgbegin) then writefile ('JPG',jpgbegin,jpglength);
  end;
End;

Procedure FoundPCX; {Only detection of JPG}
var Nplanes,i,Cnt,i3:byte;
    i2,error,TotalBytes,Ymax,Ymin,BytesPerLine:word;
    l2,l3,pcxBegin,pcxLength:longint;

Begin
  pcxLength:=0;
  PCXBegin := (l - res) + X;
  FastWrite('Scanning for PCX...',2,14,121);
  h_LSeek(infile2, pcxBegin+4,0);
  h_read(infile2, l3, sizeof(l3));
  if l3=0 then
    begin
      h_LSeek(infile2, pcxBegin+$A,0);
      h_read(infile2, Ymax, sizeof(Ymax));
      h_LSeek(infile2, pcxBegin+$41,0);
      h_read(infile2, Nplanes, sizeof(Nplanes));
      h_read(infile2, BytesPerLine, sizeof(BytesPerLine));
      TotalBytes:=Nplanes*BytesPerLine;
      h_LSeek(infile2, pcxBegin+128,0);
      l3:=0;
      for i2:=0 to Ymax do
      begin
        l2:=0;
        repeat
          cnt:=1;
          error:=h_read(infile2, i,sizeof(i));
          if (i and $C0) = $C0 then begin  {11000000}
                                      cnt:= ($3F and i); {00111111}
                                      error:=h_read(infile2, i, sizeof(i));
                                      inc(l3);
                                    end;
          inc(l2,cnt);
          inc(l3);
       until (l2=TotalBytes) or (error<>1);
     end;
     error:=h_read(infile2, i,sizeof(i));
     if (error=1) and (i=12) then pcxlength:=l3+769+128
                             else pcxlength:=l3+128;
     if (pcxlength > 0) and ((pcxBegin + pcxlength) <= search.size) Then
     begin
        ID:='PCX File';
        FastWrite ('Resolution: '+ToStr(BytesPerLine,0)+' x '+ToStr(Ymax+1,0),2,11,113);
        If SaveIt(ID,pcxbegin) then writefile ('PCX',pcxbegin,pcxlength);
     end;
  end;
  ClearLine;

End;

Procedure writeCustom(custom:string); {Detected the Custom Header}
var position,CustomBegin,CustomLength,offset:longint;
    number:string;
    i:byte;
Begin
  Position := (l - res) + X;
  number:=option[3];
  offset:=0;
  if number[1]='$' then begin {It's an HEX value...}
                           for i:=2 to (length(number)) do
                           case number[i] of {This formula converts a HEX string to a longint}
                           '0'..'9':offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(16)));
                           'A'..'F':offset:=offset+(ORD(number[i])-$37)*trunc(exp((length(number)-i)*ln(16)));
                           end;
                         end
                    else begin {It's decimal...}
                            for i:=1 to (length(number)) do {And this converts a DECIMAL string to a longint}
                            offset:=offset+(ORD(number[i])-$30)*trunc(exp((length(number)-i)*ln(10)));
                         end;
  CustomBegin:= position-offset+1;
  Customlength := search.size - CustomBegin;
  custom[1]:='(';
  ID:='Custom '+custom+') File';
  if SaveIt(ID,position) then writefile ('TMP',custombegin,customlength);
End;

Procedure PartialCopy; {Copies a part from x to y out of a file}
var number1,number2:string;
    copybegin,copyend:longint;
    i:byte;
Begin
  number1:=option[2]; {begin}
  number2:=option[3]; {end}
  copybegin:=0;
  copyend:=0;
  upper(number1);
  upper(number2);
  if number1[2]='$' then begin {It's an HEX value...}
                           for i:=3 to (length(number1)) do
                           case number1[i] of {This formula converts a HEX string to a longint}
                           '0'..'9':copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(16)));
                           'A'..'F':copybegin:=copybegin+(ORD(number1[i])-$37)*trunc(exp((length(number1)-i)*ln(16)));
                           end;
                         end
                    else begin {It's decimal...}
                            for i:=2 to (length(number1)) do {And this converts a DECIMAL string to a longint}
                            copybegin:=copybegin+(ORD(number1[i])-$30)*trunc(exp((length(number1)-i)*ln(10)));
                         end;
  case number2[1] of
  '$': {It's an HEX value...}
       for i:=2 to (length(number2)) do
         case number2[i] of
         '0'..'9':copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(16)));
         'A'..'F':copyend:=copyend+(ORD(number2[i])-$37)*trunc(exp((length(number2)-i)*ln(16)));
         end;
  'E': if (number2[2]='N') and (number2[3]='D') then copyend:=search.size;
  else {It's decimal...}
       for i:=1 to (length(number2)) do
          copyend:=copyend+(ORD(number2[i])-$30)*trunc(exp((length(number2)-i)*ln(10)));
  end;
  if (copybegin<search.size) and (copybegin <= copyend) then writefile('$$$',copybegin,(copyend-copybegin));
end;

procedure SearchExtended;assembler;

asm
        mov cx,res
        mov di,-1
@search:cmp cx,0
        jz @nothing
        dec cx
        inc di
        mov ah,byte ptr sample[di]
        mov al,byte ptr sample[di+1]
        cmp ax,11AFh
        jb @search
        cmp ax,'if'
        ja @search
@FLI:   cmp ax,11AFh
        ja @FLC
        jb @search
        mov x,di
        push di
        push cx
        call WriteFLIorC
        pop cx
        pop di
        jmp @search
@FLC:   cmp ax,12AFh
        ja @E669
        jb @search
        mov x,di
        push di
        push cx
        call WriteFLIorC
        pop cx
        pop di
        jmp @search
@E669:  cmp ax,'JN'
        ja @669
        jb @search
        mov x,di
        push di
        push cx
        call Write669
        pop cx
        pop di
        jmp @search
@669:   cmp ax,'if'
        jnz @search
        mov x,di
        push di
        push cx
        call Write669
        pop cx
        pop di
        jmp @search
@nothing:
end;

procedure SearchCustom;
var custom:string;

begin
  custom:=option[2];
  for X:=0 to res do
     begin
       found:=0;
       for y:=1 to (ord(custom[0])-1) do
                                      if sample[X+Y]=custom[Y+1] then inc(found);
       if found=ord(custom[0])-1 then writeCustom(custom);
     end;
end;

procedure SearchEngine;assembler;
asm
        mov cx,res
        mov di,-1
@search:cmp cx,0
        jz @nothing
        dec cx
        inc di
        mov ah,byte ptr sample[di]
        mov al,byte ptr sample[di+1]
        mov bh,byte ptr sample[di+2]
        mov bl,byte ptr sample[di+3]
        cmp ax,$0A05
        jb @search
        cmp ax,'md'
        ja @search

        cmp ax,$0A05
        ja @AU
        cmp bl,$08  { $0108 -> packed ; $0008 -> unpacked}
        jnz @search
        mov x,di
        push di
        push cx
        call FoundPCX
        pop cx
        pop di
        jmp @search

@AU:    cmp ax,'.s'
        ja @MOD
        jnz @search
        cmp bx,'nd'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteAU
        pop cx
        pop di
        jmp @search
@MOD:   cmp ax,'32'
        ja @CHN
        cmp al,'0'
        jb @search
        cmp ah,'1'
        jb @search
        cmp bx,'CH'
        jnz @CHN
        mov x,di
        cmp al,'9'
        ja @CHN
        sub ah,030h         {Convert chars in AX to normal word}
        sub al,030h
        mov dl,al
        mov al,ah
        xor ah,ah
        mov bl,10
        mul bl
        add al,dl
        shl ax,8
        mov patternsize,ax
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@CHN:   cmp ah,'1'
        jb @search
        cmp ah,'9'
        ja @BMOD
        cmp al,'C'
        jnz @BMOD
        cmp bx,'HN'
        jnz @search
        mov x,di
        shr ax,8
        sub al,030h
        shl ax,8
        mov patternsize,ax
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@BMOD:  cmp ax,'2S'
        ja @AMF
        cmp bx,'TM'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@AMF:   cmp ax,'AM'
        ja @BMP
        jb @search
        cmp bh,'F'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteAMF
        pop cx
        pop di
        jmp @search
@BMP:   cmp ax,'BM'
        ja @CMF
        jb @search
        mov x,di
        push di
        push cx
        call WriteBMP
        pop cx
        pop di
        jmp @search
@CMF:   cmp ax,'CT'
        ja @VOC
        jb @search
        cmp bx,'MF'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteCMF
        pop cx
        pop di
        jmp @search
@VOC:   cmp ax,'Cr'
        ja @DMF
        jb @search
        cmp bx,'ea'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteVOC
        pop cx
        pop di
        jmp @search
@DMF:   cmp ax,'DD'
        ja @MDL
        jb @search
        cmp bx,'MF'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteDMF
        pop cx
        pop di
        jmp @search
@MDL:   cmp ax,'DM'
        ja @XM
        jb @search
        cmp bx,'DL'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteMDL
        pop cx
        pop di
        jmp @search
@XM:    cmp ax,'Ex'
        ja @FAR
        jb @search
        cmp bx,'te'
        jnz @AMS
        jnz @search
        mov x,di
        push di
        push cx
        call WriteXM
        pop cx
        pop di
        jmp @search
@AMS:   cmp bx,'tr'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteAMS
        pop cx
        pop di
        jmp @search
@FAR:   cmp ax,'FA'
        ja @FLT4
        jb @search
        cmp bx,'R■'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteFAR
        pop cx
        pop di
        jmp @search
@FLT4:  cmp ax,'FL'
        ja @IFF
        jb @search
        cmp bx,'T4'
        jnz @FLT8
        mov patternsize,1024
        mov x,di
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@FLT8:  cmp bx,'T8'
        jnz @search
        mov patternsize,2048
        mov x,di
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@IFF:   cmp ax,'FO'
        ja @FNK
        jb @search
        cmp bx,'RM'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteIFF
        pop cx
        pop di
        jmp @search
@FNK:   cmp ax,'Fu'
        ja @GDM
        jb @search
        cmp bx,'nk'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteFNK
        pop cx
        pop di
        jmp @search
@GDM:   cmp ax,'GD'
        ja @GIF
        jb @search
        cmp bx,'M■'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteGDM
        pop cx
        pop di
        jmp @search
@GIF:   cmp ax,'GI'
        ja @HMI
        jb @search
        cmp bx,'F8'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteGIF
        pop cx
        pop di
        jmp @search
@HMI:   cmp ax,'HM'
        ja @D00
        jb @search
        cmp bx,'IM'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteHMI
        pop cx
        pop di
        jmp @search
@D00:   cmp ax,'JC'
        ja @JPG
        jb @search
        cmp bh,'H'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteD00
        pop cx
        pop di
        jmp @search
@JPG:   cmp ax,'JF'
        ja @ANM
        jb @search
        cmp bx,'IF'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteJPG
        pop cx
        pop di
        jmp @search
@ANM:   cmp ax,'LP'
        ja @MK2
        jb @search
        cmp bx,'F '
        jnz @search
        mov x,di
        push di
        push cx
        call WriteANM
        pop cx
        pop di
        jmp @search
@MK2:   cmp ax,'M!'
        ja @MK1
        jb @search
        cmp bx,'K!'
        jnz @search
        mov patternsize,1024
        mov x,di
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@MK1:   cmp ax,'M.'
        ja @ULT
        jb @search
        cmp bx,'K.'
        jnz @search
        mov patternsize,1024
        mov x,di
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@ULT:   cmp ax,'MA'
        ja @MTM
        jb @search
        cmp bx,'S_'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteULT
        pop cx
        pop di
        jmp @search
@MTM:   cmp ax,'MT'
        ja @MUS
        jb @search
        cmp bh,'M'
        jnz @MIDI
        mov x,di
        push di
        push cx
        call WriteMTM
        pop cx
        pop di
        jmp @search
@MIDI:  cmp bx,'hd'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteMIDI
        pop cx
        pop di
        jmp @search
@MUS:   cmp ax,'MU'
        ja @MXM
        jb @search
        cmp bx,$531A {S,$1A}
        jnz @search
        mov x,di
        push di
        push cx
        call WriteMUS
        pop cx
        pop di
        jmp @search
@MXM:   cmp ax,'MX'
        ja @OCTA
        jb @search
        cmp bx,$4D00
        jnz @search
        mov x,di
        push di
        push cx
        call WriteMXM
        pop cx
        pop di
        jmp @search
@OCTA:  cmp ax,'OC'
        ja @PAC
        jb @search
        cmp bx,'TA'
        jnz @search
        mov patternsize,2048
        mov x,di
        push di
        push cx
        call WriteMOD
        pop cx
        pop di
        jmp @search
@PAC:   cmp ax,'PA'
        ja @PSM
        jb @search
        cmp bx,'CG'
        jnz @search
        mov x,di
        push di
        push cx
        call WritePAC
        pop cx
        pop di
        jmp @search
@PSM:   cmp ax,'PS'
        ja @PTM
        jb @search
        cmp bx,'M '
        jnz @search
        mov x,di
        push di
        push cx
        call WritePSM
        pop cx
        pop di
        jmp @search
@PTM:   cmp ax,'PT'
        ja @RAD
        jb @search
        cmp bx,'MF'
        jnz @search
        mov x,di
        push di
        push cx
        call WritePTM
        pop cx
        pop di
        jmp @search
@RAD:   cmp ax,'RA'
        ja @RIFF
        jb @search
        cmp bh,'D'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteRAD
        pop cx
        pop di
        jmp @search
@RIFF:  cmp ax,'RI'
        ja @SAdT
        jb @search
        cmp bx,'FF'
        jnz @RIX
        mov x,di
        push di
        push cx
        call FoundRIFF
        pop cx
        pop di
        jmp @search
@RIX:   cmp bx,'X3'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteRIX
        pop cx
        pop di
        jmp @search
@SAdT:  cmp ax,'SA'
        ja @S3M
        jb @search
        cmp bx,'dT'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteSAdT
        pop cx
        pop di
        jmp @search
@S3M:   cmp ax,'SC'
        ja @UNI
        jb @search
        cmp bx,'RM'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteS3M
        pop cx
        pop di
        jmp @search
@UNI:   cmp ax,'UN'
        ja @DLZ
        jb @search
        cmp bh,'0'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteUNI
        pop cx
        pop di
        jmp @search
@DLZ:   cmp ax,'dl'
        ja @STM2
        jb @search
        cmp bh,'z'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteDLZ
        pop cx
        pop di
        jmp @search
@STM2:  cmp ax,'eP'
        ja @STM
        jb @search
        cmp bx,'ro'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@STM:   cmp ax,'ea'
        ja @MOV
        jb @search
        cmp bx,'m!'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteSTM
        pop cx
        pop di
        jmp @search
@MOV:   cmp ax,'md'
        jnz @search
        cmp bx,'at'
        jnz @search
        mov x,di
        push di
        push cx
        call WriteMOV
        pop cx
        pop di
        jmp @search
@nothing:
end;

Begin {Main Program}
  if IsVga then
    begin
      asm
        mov ax,3h
        int 10h
      end;
{$IFNDEF DEBUG}
      asm push cs end; {Well...this seems to be a HUGE error in TP}
      SetFont;
{$ENDIF}
      CursorOff;
      filenum:=0;
      GetMem(pFileName,80);
        begin
          If (GetArgCount = 0) Then begin
                                      DisplayHelp;
                                      if option[1] = #0 then SmoothExit;
                                    end
                               Else begin
                                      GetMem(pP,80); {Reserve some memory for commandline string}
                                      GetArgStr(pp,1,80);  {Filename, specified at commandline}
                                      option[1]:=StrPas(PP);
                                      if option[1]='*' then option[1]:='*.*';
                                      GetArgStr(PP,2,80);  {Filename, specified at commandline}
                                      option[2]:=StrPas(PP);
                                      GetArgStr(PP,3,80);  {Filename, specified at commandline}
                                      option[3]:=StrPas(PP);
                                    end;
          for y:=2 to 24 do
          FastWrite('                                                                                 ',1,y,121);
          FastWrite (' Fast Module Extractor '+version+'                                                     ',1,1,79);
          FastWrite ('                  The easy way to extract music and graphics                    ',1,25,30);
          for y:=50 to 50+24 do FastWrite('▒',y,7,112);
          for y:=50 to 50+24 do FastWrite('▒',y,9,112);
          FastWrite(' Processing:           bytes of           bytes',1,7,121);
          FastWrite('%',79,7,126);
          FastWrite(' Processing:           bytes of           bytes',1,9,121);
          FastWrite('%',79,9,126);
          drawline(13,125);
          drawline (15,117);
          PP:=Pas2PChar(option[1]);
          FilesInDir:=0;
          doserror:=FindFirst (PP, 0, Search);
          while doserror = 0 do
           begin
             inc(FilesInDir);
             doserror:=FindNext(search);
           end;

          doserror:=FindFirst (PP, 0, Search);
          FileSplit (PP, D, N, E);
          filename:=StrPas(D);
          filename:=filename+Search.Name;
          if option[2,1]='#' then
            begin
              FastWrite('Partial copy mode',2,19,113);
              FastWrite('Copying from: '+ search.name,2,21,113);
              Pfilename:=Pas2PChar(filename);
              infile2:=h_Openfile(PFilename,0);
              PartialCopy;
              h_closefile(infile2);
              waitforkey;
          end
          else
          if doserror=0 then
            begin
              for fx:= 1 to FilesInDir Do
                begin
                  upper(filename);
                  Pfilename:=Pas2PChar(filename);
                  infile1:=h_Openfile(PFilename,0);
                  Attr:=GetFileAttr(Pfilename);
                  if Attr and faReadOnly <> 0 then begin
                                                     Readonlyfile := True; {Remove read-only attr}
                                                     SetFileAttr(pas2pchar(filename), faArchive);
                                                   end
                  else Readonlyfile := False;
                      infile2:=h_Openfile(PFilename,0);
                      l := 0;
                      FastWrite('Filename: '+strpas(pfilename)+'                     ',2,5,127);
                      FastWrite('Files to be scanned: '+ToStr(FilesInDir - fx,0)+'      ',2,3,$7B);
                      res:=0;
                      if search.size > 0 then
                        repeat
                          res:=h_read (infile1, sample, SizeOf (sample));
                          l:=l+longint(res);
                          FastWrite ('Processing: '+ToStr(l,9),2,7,121);
                          FastWrite ('bytes of '+ToStr(search.size,9)+' bytes',24,7,121);
                          drawbar(l*100 div search.size,50,7);
                          case option[2,1] of
                          'X','x': begin
                                     FastWrite ('┤Extended mode├',65,15,117);
                                     SearchExtended;
                                   end;
                          '!':     begin
                                     FastWrite ('┤Custom mode├',67,15,117);
                                     SearchCustom;
                                   end;
                          end;
{----------------------------------------------------------------------------}
                          SearchEngine; {The central search-engine!}
{----------------------------------------------------------------------------}
                          if port[$60]=1 then SmoothExit; {Quick-escape...}
                        until res < buffer;
                      if readonlyfile Then Attr:=SetFileAttr(pas2pchar(filename), faReadonly+faArchive);
                      h_CloseFile(infile1);
                      h_CloseFile(infile2);
                      doserror:=FindNext(search);
                      filename:=StrPas(D);
                      filename:=filename+Search.Name;
                      for y:=50 to 50+24 do FastWrite('▒',y,7,112);
                end;
              FastWrite('Scan completed',2,14,121);
              waitforkey;
            end
          else
            begin
              FastWrite('File not found',2,14,121);
              readkey;
            end;
        end;
    SmoothExit;
    end
  else FastWrite('This program requires a VGA-compatible video-board',1,1,7);
End.